PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/crtplus.com/CRTPLUS.PAS

Pascal/Delphi Source File | 1990-01-14 | 22.0 KB | 767 lines

{

    CrtPlus.pas
    1-14-90

    Keyboard, cursor, and window enhancements to
    Turbo Pascal 5.5's Crt unit.

    Copyright 1990
    John W. Small
    All rights reserved

    PSW / Power SoftWare
    P.O. Box 10072
    McLean, Virginia 22102 8072

    If you acquired the CrtPlus ToolBox through 'shareware'
    and find it useful, a registration fee of $20 would
    be appreciated.  Upon registion you will be sent source
    code, manual on disk, the latest example programs, and
    notices of updates.

    Notice:  The source code is not shareware, nor has it
    been released into the public domain.  Please respect my
    copyright!  Your are free to distribute crtplus.tpu,
    the interface section only of crtplus.pas, and any
    demos along with your own programs.  Thanks, John.


    Works consulted:

    Norton, Peter. "Programmer's Guide to the IBM PC."
            Bellevue, Washington: Microsoft Press, 1985.

    Norton, Peter. "The New Peter Norton Programmer's Guide
            to the IBM PC & PS/2." Bellevue, Washington:
            Microsoft Press, 1988.

    Duncan, Ray. "Advanced MS DOS.", Bellevue Washington:
            Microsoft Press, 1986.

    Wilton, Richard. "Programmer's Guide to PC & PS/2
            Video Systems.", Bellevue Washington:
            Microsoft Press, 1987.

    Persons consulted:

    Saucci, Andrew Jr.  MegaPost via telephone conversation
            on enhanced keyboard operations.

}

unit CrtPlus;

interface

    uses dos, crt;

    const

        {
            The ascii codes listed below are returned by
            CrtPlus.ReadKey, and by Crt.ReadKey (first call).
        }

        ESC         =   #27;
        CR          =   #13;
        Tab         =    #9;
        BackSp      =    #8;
        Space       =   #32;
        DelCh       =  #127;

        CtrlA       =    #1;
        CtrlB       =    #2;
        CtrlC       =    #3;
        CtrlD       =    #4;
        CtrlE       =    #5;
        CtrlF       =    #6;
        CtrlG       =    #7;
        CtrlH       =    #8;
        CtrlI       =    #9;
        CtrlJ       =   #10;
        CtrlK       =   #11;
        CtrlL       =   #12;
        CtrlM       =   #13;
        CtrlN       =   #14;
        CtrlO       =   #15;
        CtrlP       =   #16;
        CtrlQ       =   #17;
        CtrlR       =   #18;
        CtrlS       =   #19;
        CtrlT       =   #20;
        CtrlU       =   #21;
        CtrlV       =   #22;
        CtrlW       =   #23;
        CtrlX       =   #24;
        CtrlY       =   #25;
        CtrlZ       =   #26;

        {
            EnhKey is returned by CrtPlus.EnhReadKey
            whenever a 101/102 keyboard enhanced key stroke
            is reported.  The scan code of the enhanced key
            remains the same as that  reported on 83/84
            keyboards and by CrtPlus.ReadKey, only #224 is
            returned instead of #0 as the ascii character.

            There are several exceptions:

                F11/12  EnhReadKey returns ascii #0.

            If the enhanced key stroke replicates a regular
            ascii character then EnhReadKey returns that
            ascii character and #224 as the scan code via
            CrtPlus.asciiScan high byte, e.g.

                Enter (keypad)  ascii = #13, scan = #224.
                Enter (regular) ascii = #13, scan = #28.

        }

        EnhKey      =   #224;



        {
            The scan codes listed below are returned when
            (CrtPlus.ReadKey = #0) via the global variable,
            CrtPlus.asciiScan, i.e.

                char(hi(CrtPlus.asciiScan)),

            or by Crt.ReadKey (second call).  Please note
            that CrtPlus.ReadKey requires only one call
            since the extended character set characters are
            returned in high byte of CrtPlus.asciiScan.
            CrtPlus.ReadKey is faster than Crt.ReadKey since
            it is inline code which also explains why I
            couldn't make the keyboard into an object.
        }

        AltA        =    #30;
        AltB        =    #48;
        AltC        =    #46;
        AltD        =    #32;
        AltE        =    #18;
        AltF        =    #33;
        AltG        =    #34;
        AltH        =    #35;
        AltI        =    #23;
        AltJ        =    #36;
        AltK        =    #37;
        AltL        =    #38;
        AltM        =    #50;
        AltN        =    #49;
        AltO        =    #24;
        AltP        =    #25;
        AltQ        =    #16;
        AltR        =    #19;
        AltS        =    #31;
        AltT        =    #20;
        AltU        =    #22;
        AltV        =    #47;
        AltW        =    #17;
        AltX        =    #45;
        AltY        =    #21;
        AltZ        =    #44;

        Home        =    #71;
        UpArr       =    #72;
        PgUp        =    #73;
        LArr        =    #75;
        RArr        =    #77;
        EndKey      =    #79;
        DnArr       =    #80;
        PgDn        =    #81;
        InsKey      =    #82;
        DelKey      =    #83;

        CtrlHome    =    #119;
        CtrlPgUp    =    #132;
        CtrlLArr    =    #115;
        CtrlRArr    =    #116;
        CtrlEnd     =    #117;
        CtrlPgDn    =    #118;


        Alt1        =    #120;
        Alt2        =    #121;
        Alt3        =    #122;
        Alt4        =    #123;
        Alt5        =    #124;
        Alt6        =    #125;
        Alt7        =    #126;
        Alt8        =    #127;
        Alt9        =    #128;
        Alt0        =    #129;

        AltHyphen   =    #130;
        AltEquals   =    #131;
        CtrlPrtSc   =    #114;
        ShiftTab    =     #15;


        F1          =     #59;
        ShiftF1     =     #84;
        CtrlF1      =     #94;
        AltF1       =    #104;

        F2          =     #60;
        ShiftF2     =     #85;
        CtrlF2      =     #95;
        AltF2       =    #105;

        F3          =     #61;
        ShiftF3     =     #86;
        CtrlF3      =     #96;
        AltF3       =    #106;


        F4          =     #62;
        ShiftF4     =     #87;
        CtrlF4      =     #97;
        AltF4       =    #107;

        F5          =     #63;
        ShiftF5     =     #88;
        CtrlF5      =     #98;
        AltF5       =    #108;

        F6          =     #64;
        ShiftF6     =     #89;
        CtrlF6      =     #99;
        AltF6       =    #109;

        F7          =     #65;
        ShiftF7     =     #90;
        CtrlF7      =    #100;
        AltF7       =    #110;

        F8          =     #66;
        ShiftF8     =     #91;
        CtrlF8      =    #101;
        AltF8       =    #111;

        F9          =     #67;
        ShiftF9     =     #92;
        CtrlF9      =    #102;
        AltF9       =    #112;

        F10         =     #68;
        ShiftF10    =     #93;
        CtrlF10     =    #103;
        AltF10      =    #113;

        {
            Returned via char(hi(CrtPlus.asciiScan)) only
            after call to CrtPlus.EnhReadKey returns $E0.
        }

        F11         =    #133;
        ShiftF11    =    #135;
        CtrlF11     =    #137;
        AltF11      =    #139;

        F12         =    #134;
        ShiftF12    =    #136;
        CtrlF12     =    #138;
        AltF12      =    #140;


        {
            BIOS keyboard shift constants used to mask value
            returned by CrtPlus.ReadShift and
            CrtPlus.EnhReadShift, e.g.

                if boolean(CapsLock and ReadShift) then ...
        }

        InsertState         =   $0080;
        CapsLock            =   $0040;
        NumLock             =   $0020;
        ScrollLock          =   $0010;
        AltPressed          =   $0008;
        CtrlPressed         =   $0004;
        LeftShiftPressed    =   $0002;
        RightShiftPressed   =   $0001;
        ShiftPressed        =   $0003;


        {
            BIOS extended keyboard shift constants used to
            mask value return by CrtPlus.EnhReadShift, e.g.

                if boolean(CapsLock and EnhReadShift)
                    then ...
        }

        SysReqPressed       =   $8000;
        CapsLockPressed     =   $4000;
        NumLockPressed      =   $2000;
        ScollLockPressed    =   $1000;
        RightAltPressed     =   $0800;
        RightCtrlPressed    =   $0400;
        LeftAltPressed      =   $0200;
        LeftCtrlPressed     =   $0100;


        {
            Typematic Rate and Delay Constants to be used
            with call to CrtPlus.EnhSetTypeMatic().

            TMR218 represents:

                Typematic Rate of 21.8 char/sec.

            TMD750 represents

                Typematic Delay of 750 millisec.
        }

        TMR300  =   $00;
        TMR267  =   $01;
        TMR240  =   $02;
        TMR218  =   $03;
        TMR200  =   $04;
        TMR185  =   $05;
        TMR171  =   $06;
        TMR160  =   $07;
        TMR150  =   $08;
        TMR133  =   $09;
        TMR120  =   $0A;
        TMR109  =   $0B;
        TMR100  =   $0C;
        TMR092  =   $0D;
        TMR086  =   $0E;
        TMR080  =   $0F;
        TMR075  =   $10;
        TMR067  =   $11;
        TMR060  =   $12;
        TMR055  =   $13;
        TMR050  =   $14;
        TMR046  =   $15;
        TMR043  =   $16;
        TMR040  =   $17;
        TMR037  =   $18;
        TMR033  =   $19;
        TMR030  =   $1A;
        TMR027  =   $1B;
        TMR025  =   $1C;
        TMR023  =   $1D;
        TMR021  =   $1E;
        TMR020  =   $1F;

        TMD250  =   $00;
        TMD500  =   $01;
        TMD750  =   $02;
        TMD1000 =   $03;


    type

        {
            TextFrameChars are the IBM extended character
            set characters used to draw line boxes.  Imagine
            a box with a cross inside, then the characters
            needed to draw this are typified by the corners
            of the box, the four points the cross touches
            the outside box, and the center of the cross.

            Indices into textFrameChars are thus:

                rt = top-right corner of the box,
                mm = middle-middle or center of cross,
                mb = middle-bottom where cross touches
                        the bottom of the box
                etc.
        }

        textFrameChars = (v,h,lt,rt,rb,lb,ml,mt,mr,mb,mm);

        textFrame = array[textFrameChars] of char;

    const

        {
            Text Box Drawing Characters:

                svsh = single vert., single horizonal lines
                dvdh = double vert., double horizonal lines
                etc.
        }

        svsh : textFrame =
            #179#196#218#191#217#192#195#194#180#193#197;
        svdh : textFrame =
            #179#205#213#184#190#212#198#209#181#207#216;
        dvsh : textFrame =
            #186#196#214#183#189#211#199#210#182#208#215;
        dvdh : textFrame =
            #186#205#201#187#188#200#204#203#185#202#206;

    type


        { Cursor object for turning on/off cursor, etc. }

        CursorShape = object                { CURSORSHAPE }
            OrigShape, prevShape : word;
            procedure init;     { Do not call! }
            function  getShape : word;
            procedure putShape (shape : word);
            function  defaultShape : word;
            procedure off;
            procedure on;
            procedure block;
            procedure normal;
            procedure restore;
            procedure done;
        end;



        { Object for storing text screen images. }

        TextImage = object                  { TEXTIMAGE }
            ImageMin, ImageMax : word;
            image : ^word;
            procedure init (x1, y1, x2, y2 : byte);
            procedure done
        end;



        {
            Turbo Pascal's text-screen state, i.e. current
            window, text attribute, cursor position, and
            cursor shape.
        }

        TurboWindow = object                { TURBOWINDOW }
            WindMin, WindMax : word;
            textAttr, wherex, wherey : byte;
            curshape : word;
            procedure save;
            procedure restore;
        end;



        {
            TextWindow is a direct replacement for Turbo
            Pascal's window procedure.  It sets the current
            window, like Turbo Pascal does, but it also
            saves the shadow beneath the window and the
            screen state before the window was called.  When
            done is called the window is removed and the
            screen returned to its previous state.  Call
            TxtScr.TextMode() instead of Crt.TextMode()
            when changing video modes to insure proper
            operation!
        }

        TextWindow = object                 { TEXTWINDOW }
            shadow : TextImage;
            prevWind  : TurboWindow;
            procedure window (x1, y1, x2, y2 : byte);
            procedure done
        end;



        {
            The TextScreen object provides enhancements to
            Turbo Pascal's Crt unit's treatment of the text
            screen.  The TextScreen object works in all the
            text modes supported by Turbo Pascal including
            43/50 line modes!  It also respects the setting
            of Crt.CheckSnow and Crt.DirectVideo!  The only
            restriction is that your call TxtScr.TextMode()
            instead of Crt.TextMode() when changing video
            modes.
        }

        TextScreen = object                 { TEXTSCREEN }

            OrigMode, dim, vseg, vport : word;
            prevTextAttr : byte;
            state : TextWindow; { used by save and restore }
            CheckSnow, DirectVideo : boolean;
            vmode : integer;

            procedure init;     { Do not call! }


            { Use to save screen during exec calls. }

            procedure save;
            procedure restore;


            { Use instead of Crt.TextMode(). }

            procedure TextMode  (mode : integer);
            function  VideoMode : integer;
            function  IsTextMode : boolean;
            function  IsColorMode : boolean;


            { Use to extend Low/Norm/High video. }

            procedure ReverseVideo;
            procedure SetVideo  (fgrd, bgrd : byte);
            procedure BlinkVideo;
            procedure UnblinkVideo;
            procedure RestoreVideo;


            { Use to construct TextAttr bytes. }

            function  rvideo (attr : byte) : byte;
            function  svideo (fgrd, bgrd : byte) : byte;
            function  bvideo (attr : byte) : byte;
            function  ubvideo (attr : byte) : byte;
            function  lvideo (attr : byte) : byte;
            function  hvideo (attr : byte) : byte;


            { Use to save and restore screen images. }

            procedure getText   (var ti : TextImage);
            procedure putText   (var ti : TextImage);


            {
                Use instead of WhereX and WhereY for
                screen coordinates.
            }

            function  scrX : byte;
            function  scrY : byte;


            { Use to write to screen without scroll/wrap. }

            procedure scrWrite  (
                x, y, maxLen, attr : byte;
                var str : string);
            procedure scrFill   (
                x, y, len, attr : byte; ch : char);
                { Note: if ch = #0 then fill attr only }
            procedure scrHorzLn (
                left, row, right, attr: byte; ch: char);
            procedure scrVertLn (
                col, top, bottom, attr: byte; ch: char);
            procedure scrBox    (
                x1, y1, x2, y2, attr: byte;
                var tf : textFrame);


            {
                Use to write to current crt.window without
                scroll/wrap
            }

            procedure windWrite (var str : string);
            procedure windLightBar (x, y, len, attr : byte);
            procedure windColor (fgrd, bgrd : byte);


            {  Call to restore original crt mode. }

            procedure done
        end;



        {
            FramedTextWindow is a popup window object drived
            from the TextWindow object.  This window has an
            optional border, title and/or footer, and scroll
            bar(s).  This object provides an example of how
            the TextWindow object is extensible and can be
            used as a base class object to construct any
            type of text window!  Call TxtScr.TextMode()
            instead of Crt.TextMode() when changing video
            modes to insure proper operation!
        }

                                    { FRAMEDTEXTWINDOW }

        FramedTextWindow = object(TextWindow)
            procedure window (x1, y1, x2, y2 : byte);
            procedure frame  (
                attr : byte; var f : textFrame);
            procedure titleFooter (
                title : boolean; attr : byte; str : string);
            procedure scrollBar (
                vert : boolean; attr : byte;
                var f : textFrame; p, maxp : integer);
            { Uses procedure TextWindow.done; }
        end;



        {
            ShadowTextWindow is yet another popup window
            object drived from the TextWindow object.  This
            window has an title bar and shadow beneath the
            window.  This object is yet another extension to
            the TextWindow object.  Call TxtScr.TextMode()
            instead of Crt.TextMode() when changing video
            modes to insure proper operation!
        }

                                    { SHADOWWINDOW }

        ShadowTextWindow = object(TextWindow)
            procedure window(x1, y1, x2, y2 : byte);
            procedure title(attr : byte; str : string);
            { Uses procedure TextWindow.done; }
        end;


    var

        cursor : CursorShape;   { TEXT CURSOR OBJECT }

        TxtScr : TextScreen;    { TEXT SCREEN OBJECT }

        {
            AsciiScan contains the keystroke's ascii code
            in the low byte and scan code in the high byte.
            It is set on every call to CrtPlus.ReadKey/
            EnhReadKey/KeyPressed/EnhKeyPressed.
            CrtPlus.EnhWriteKey writes this word back into
            the keyboard buffer.
        }

        asciiScan : word;




    {
        Do not mix calls between Crt.ReadKey/Keypressed with
        CrtPlus keyboard routines!
    }


    {
        READ CHARACTER FROM KEYBOARD, BIOS intr $16, fnc $00

        Example:

        var ch : char;
        begin
            case CrtPlus.ReadKey of
                #0: case char(hi(CrtPlus.asciiScan)) of
                        LArr : ... ;
                        RArr : ... ;
                        PgUp : ... ;
                        ...
                    end;
                CR : ... ;
                ESC : ... ;
            else
                ch := char(lo(CrtPlus.asciiScan));
                ...
            end;
            ...
        end;
    }

    function  ReadKey : char;
                inline($30/$E4/             { xor ah,ah }
                    $CD/$16/                { int $16   }
                    $89/$06/CrtPlus.asciiScan);
                                    { mov asciiScan,ax }


    { IS CHARACTER WAITING? BIOS intr $16, fnc $01 }
    { Sets CrtPlus.asciiScan just like CrtPlus.ReadKey. }

    function  KeyPressed : boolean;


    { READ KEYBOARD SHIFT STATE.  BIOS intr $16, fnc $02 }

    function  ReadShift : word;
                inline($B4/$02/         { mov ah,2  }
                    $CD/$16/            { int $16   }
                    $30/$E4);           { xor ah,ah }



    {
        ATTENTION!!!

        Keyboard routines with "Enh" prefixes can only
        be used on machines as follows:

            XT with BIOS dated 01/10/86 and later,
            AT with BIOS dated 11/15/85 and later, and
            PS/2s.

        The EnhSetTypeMatic routine can also be used on
        the PCjr but not the XT!

        The extended keyboard routines were designed to
        return character codes and scan codes for the
        AT's and PS/2's enhanced keyboard.  I haven't
        found a realiable way to determine the presence
        of the enhanced keyboard since many clones don't
        have BIOS date strings or machine IDs.  If you
        have to use them do, but it's up to your program
        to decide if it's okay.
    }



    { SET TYPEMATIC RATE AND DELAY }
    { BIOS intr $16, fnc $03 }
    { Use only on PCjr, AT w/bios > 11/15/85, & PS/2 }

    procedure EnhSetTypeMatic(TMrate, TMdelay : byte);


    { WRITE EXTENDED CHARACTER TO KEYBOARD }
    { BIOS intr $16, fnc $05 }

    procedure EnhWriteKey;
                inline($B4/$05/         { mov ah,5  }
                    $8B/$06/CrtPlus.asciiScan/
                                    { mov ax,asciiScan }
                    $CD/$16);           { int $16   }


    { READ EXTENDED CHARACTER FROM KEYBOARD }
    { BIOS intr $16, fnc $10 }

    function  EnhReadKey : char;
                inline($B4/$10/             { mov ah,$10 }
                    $CD/$16/                { int $16   }
                    $89/$06/CrtPlus.asciiScan);
                                    { mov asciiScan,ax }

    { IS EXTENDED CHARACTER WAITING? }
    { BIOS intr $16, fnc $11 }

    function  EnhKeyPressed : boolean;


    { READ EXTENDED KEYBOARD SHIFT STATE }
    { BIOS intr $16, fnc $12 }

    function  EnhReadShift : word;
                inline($B4/$12/         { mov ah,$12}
                    $CD/$16);           { int $16   }



    { FLUSH KEYBOARD BUFFER }

    procedure ClrKey;